Análisis de los datos electorales

Paquetes necesarios

Code
rm(list = ls())
library(tidyverse)
library(glue)
library(forcats)
library(lubridate)
library(waffle)
library(ggpol)
library(ggforce)
library(sf) # para importar archivos shapefiles
library(broom) # Para transformar los archivos shapefiles 
library(gridExtra)
library(grid)
library(gganimate)

Datos empleados

  • election_data: archivo con las elecciones al congreso
  • cod_mun: archivo con los códigos y nombres de cada municipio
  • abbrev: siglas de cada partido
  • surveys: encuestas electorales desde 1982.
  • escannos_provincia_anno: número de escaños por provincia y año
  • shapefile_provincias: mapa de cada provincia

Depuración de datos

Datos únicamente del período de tiempo que incluye las elecciones desde 2008 hasta las últimas elecciones de 2019.

Solo nos interesarán los siguientes partidos:

-   PARTIDO SOCIALISTA OBRERO ESPAÑOL
-   PARTIDO POPULAR
-   CIUDADANOS
-   PARTIDO NACIONALISTA VASCO
-   BLOQUE NACIONALISTA GALLEGO
-   UNIDAS PODEMOS - IU
-   ESQUERRA REPUBLICANA DE CATALUNYA
-   EH - BILDU 
-   VOX

Convertir a tidy data

Code
eleccion_tidy <- 
  election_data |> 
  pivot_longer(cols = c(16:471), 
               names_to = "partido", 
               values_to = "votos", 
               values_drop_na = TRUE)
Code
tabla <- eleccion_tidy |> 
  distinct(anno, mes, tipo_eleccion, vuelta, codigo_distrito_electoral)

tabla
# A tibble: 6 × 5
   anno mes   tipo_eleccion vuelta codigo_distrito_electoral
  <dbl> <chr> <chr>          <dbl>                     <dbl>
1  2008 03    02                 1                         0
2  2011 11    02                 1                         0
3  2015 12    02                 1                         0
4  2016 06    02                 1                         0
5  2019 04    02                 1                         0
6  2019 11    02                 1                         0

Datos de 6 elecciones nacionales: 2008,2011,2015,2016,2019 (abril) y 2019 (noviembre).

Depuración nombres de partidos

Creación de una función para depurar los nombres de los partidos y reagrupar los demás partidos en la categoría “Otros”.

Code
nombres_partidos <- c("PARTIDO SOCIALISTA OBRERO ESPAÑOL","PARTIDO POPULAR", "CIUDADANOS", "PARTIDO NACIONALISTA VASCO", "BLOQUE NACIONALISTA GALLEGO", "UNIDAS PODEMOS - IU", "ESQUERRA REPUBLICANA DE CATALUNYA",  "EH - BILDU", "VOX")

cambia_nombres <- function(partido, nombres) {
  partido_min <- str_to_lower(partido)
  nombres_min <- str_to_lower(nombres)
  
  if (str_detect(partido_min, "\\bsortu\\b|\\beusko alkartasuna\\b|\\baralar\\b|\\balternatiba\\b|\\beuskal herria bildu\\b")) { 
    #Añado el nombre completo de EH - Bildu y cambio a str_detect porque antes no captaba todo lo que debía (ej 2008, Victoria-Gasteiz EZKER BATUA-BERDEAK-ALTERNATIVA)
    return("EH - BILDU")
  }
  
   if (str_detect(partido_min, "\\bunidas podemos\\b|\\bunidos podemos\\b|\\bpodemos\\b|\\biu\\b|\\bpodem\\b|\\bezker batua\\b")) {
    return("UNIDAS PODEMOS - IU")
  }
  
  if (str_detect(partido_min,"\\bpartido nacionalista vasco\\b")) {
    return("PARTIDO NACIONALISTA VASCO")
  }
  
  if (str_detect(partido_min,"\\bpsoe\\b|\\bpartido socialista obrero español\\b\\bpartido socialista de euskadi\\b|\\bpartit dels socialistes de catalunya\\b|\\bpartido dos socialistas de galicia\\b")) {
    return("PARTIDO SOCIALISTA OBRERO ESPAÑOL")
  }
  
    if (str_detect(partido_min,"\\bpp\\b|\\bpartido popular\\b")) {
    return("PARTIDO POPULAR")
    }
  
  if (str_detect(partido_min,"\\bbloque nacionalista galego\\b")) {
    return("BLOQUE NACIONALISTA GALLEGO")  
  }
  
  if (str_detect(partido_min,"\\bpartido de la ciudadanía\\b|\\bpartido de la ciudadania\\b")) {
    return("CIUDADANOS")  
  }
  
  if (str_detect(partido_min,"\\besquerra republicana de catalunya\\b")) { #Nótese que quedan aún partidos tipo coalición (considero que deberían incluirse)
    return("ESQUERRA REPUBLICANA DE CATALUNYA")  
  }
  
  if (any(partido_min == nombres_min)) {
    return(partido)  
  }
  
  return("OTRO")
}

#Aplicar función al dataframe
eleccion_tidy_filt <- 
  eleccion_tidy |> 
  rowwise() |> 
  mutate(partido_n = cambia_nombres(partido, nombres_partidos))

#Reagrupar partido "otro"
eleccion_resumen <- 
  eleccion_tidy_filt |>
  group_by(partido_n,anno,mes,codigo_ccaa,codigo_provincia,codigo_municipio) |> 
  mutate(votos_totales_partido = sum(votos)) |> 
  ungroup() # Ver anotaciones del cambio

Encuestas

Debes descartar las encuestas que:

-   se refieran a elecciones anteriores a 2008
-   sean a pie de urna
-   tamaño muestral desconocido o inferior a 500.
-   tenga 1 día o menos de trabajo de campo.
Code
surveys_tidy <- 
  surveys |> 
  pivot_longer(cols = c(11:59), 
               names_to = "partidos", 
               values_to = "intencion_voto", 
               values_drop_na = TRUE) |>
  drop_na(size) |>  
  filter(size >=500 & exit_poll == FALSE) |>   #tamaño muestral y a pie de urna
  filter(date_elec >= "2008-01-01") |>  #elecciones desde 2008
  mutate(duracion_t_campo = field_date_to - field_date_from) |> 
  filter(duracion_t_campo > 1) |> #descartar enucentas con 1 días o menos de trabajo de campo
  select(-exit_poll) |>  #quitar var. a pie de urna porque no es informativa (sólo quedan las que no lo)
  mutate(siglas = case_when(
            partidos == "PSOE" ~ "PSOE",
            partidos == "PP" ~ "PP",
            partidos == "CC" ~ "C's",
            partidos == "BNG" ~ "BNG",
            partidos == "ERC" ~ "ERC",
            partidos == "IU" ~ "PODEMOS-IU",
            partidos == "UP" ~ "PODEMOS-IU",
            partidos == "PODEMOS" ~ "PODEMOS-IU",
            partidos == "EH-BILDU" ~ "EH-BILDU",
            partidos == "EAJ-PNV" ~ "PNV",
            partidos == "VOX" ~ "VOX",
            TRUE ~ "OTRO" ))

Creación de tabla maestra

Tabla maestra que contiene nombres de municipios, sus códigos y las siglas de cada partido.

Code
# Tabla maestra que contiene nombres de municipios, sus códigos y las siglas de cada partido (para facilitar la visualización)

abbrev_modif <- abbrev|> 
  rowwise() |> 
  mutate(partidos = cambia_nombres(denominacion, nombres_partidos)) |> 
  select(-denominacion) |> 
  distinct(partidos, .keep_all = TRUE) |> 
  mutate(siglas = case_when(
    partidos == "PARTIDO NACIONALISTA VASCO"  ~ "PNV",
    partidos == "PARTIDO SOCIALISTA OBRERO ESPAÑOL"  ~ "PSOE",
    partidos == "UNIDAS PODEMOS - IU" ~ "PODEMOS-IU",
    partidos == "EH - BILDU" ~ "EH-BILDU",
    partidos == "OTRO"  ~ "OTRO",
    TRUE ~ siglas))

tabla_maestra <-
  eleccion_resumen |> 
  unite(col = "cod_poblacion", codigo_ccaa, codigo_provincia, codigo_municipio, sep = "-", remove = FALSE) |> 
  left_join(cod_mun, by =  c("cod_poblacion" = "cod_mun")) |> 
  select(-c(tipo_eleccion,vuelta)) |> 
  left_join(abbrev_modif, by = c("partido_n" = "partidos"))

Resultados generales de las elecciones

Code
# Preparamos los resultados de las elecciones, vemos qué porcentaje de votos ha ido a cada partido

datos_generales_elecciones <- 
  tabla_maestra |>
  group_by(anno,mes) |> 
  distinct(anno, mes, cod_poblacion, codigo_ccaa, codigo_provincia, codigo_municipio, codigo_distrito_electoral, censo, votos_blancos, votos_nulos, votos_candidaturas) |> 
  mutate(censo = sum(censo),
         votos_blancos = sum(votos_blancos),
         votos_nulos = sum(votos_nulos),
         votos_candidaturas = sum(votos_candidaturas),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, censo, votos_blancos, votos_nulos, votos_candidaturas) 

datos_partido <-
  tabla_maestra |> 
  group_by(anno, mes, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup() |> 
  distinct(eleccion, siglas, votos_partido) |> 
  left_join(datos_generales_elecciones, by = c("eleccion" = "eleccion")) |> 
  mutate(votos_porc_votantes_cand = round(votos_partido / votos_candidaturas, 2), # Porcentaje sobre la gente que voto candidaturas
         votos_porc_censo = round(votos_partido / censo, 2)) # Porcentaje sobre la gente censada,

datos_partido <-
  datos_partido |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE)) 

#Colores de partidos
colores_partidos <- c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                      "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                      "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                      "C's" = "#fb5000", "EH-BILDU"= "#1af7db")

#Resultados generales
grafico_resultados_elecciones <- 
  ggplot(datos_partido, aes(x = eleccion, y = votos_porc_votantes_cand, fill = siglas)) +
  geom_col(position = "fill") +
    geom_text(
    aes(
      label = ifelse(votos_porc_votantes_cand > 0.08, scales::percent(votos_porc_votantes_cand, accuracy = 1), ""),
      y = votos_porc_votantes_cand / 2
    ),
    position = position_fill(vjust = 0.5),
    size = 3,
    color = "white"
  ) +
  scale_fill_manual(values = colores_partidos) +
  labs(
    title = "Resultados generales",
    x = "Elecciones",
    y = "Porcentaje de votos",
    fill = "Partido"
  ) +
  theme_minimal() +
    theme( plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

grafico_resultados_elecciones
Code
provincias_sf <- st_as_sf(shapefile_provincias)

mas_votado_prov <-
  tabla_maestra |> 
  group_by(anno, mes, codigo_provincia, siglas) |> 
  mutate(votos_partido = sum(votos),
         eleccion = case_when(
            anno == 2008 ~ "2008",
            anno == 2011 ~ "2011",
            anno == 2015 ~ "2015",
            anno == 2016 ~ "2016",
            anno == 2019 & mes == "04" ~ 
            "2019 (abril)",
            anno == 2019 & mes == "11" ~ 
              "2019 (noviembre)")) |> 
  ungroup()

#Mapa 2015
mas_votado_prov_15 <- mas_votado_prov |> 
  filter(eleccion == "2015") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_15 <-
  mas_votado_prov_15 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_15 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_15, by = c("Codigo" = "codigo_provincia"))

grafico_pais_15 <-
  ggplot(data = provincias_sf_15) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) + 
  theme_minimal() +
  labs(title = "2015",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

#Mapa 2008
mas_votado_prov_08 <- mas_votado_prov |> 
  filter(eleccion == "2008") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_08 <-
  mas_votado_prov_08 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_08 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_08, by = c("Codigo" = "codigo_provincia"))

grafico_pais_08 <-
  ggplot(data = provincias_sf_08) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) +  
  theme_minimal() +
  labs(title = "2008",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

#Mapa 2019(nov)
mas_votado_prov_19 <- mas_votado_prov |> 
  filter(eleccion == "2019 (noviembre)") |> 
  distinct(eleccion, codigo_provincia, siglas, votos_partido) |> 
  group_by(eleccion, codigo_provincia) |> 
  mutate(votos_totales = sum(votos_partido)) |> 
  slice_max(votos_partido) |> 
  mutate(porc = votos_partido / votos_totales)

mas_votado_prov_19 <-
  mas_votado_prov_19 |> 
  mutate(siglas = factor(siglas, levels = c("PP","PSOE","PNV","OTRO","ERC","BNG","PODEMOS-IU","C's","EH-BILDU","VOX"), 
                         ordered = TRUE))

provincias_sf_19 <- 
  provincias_sf %>%
  left_join(mas_votado_prov_19, by = c("Codigo" = "codigo_provincia"))

grafico_pais_19 <-
  ggplot(data = provincias_sf_19) +
  geom_sf(aes(fill = siglas, alpha = porc), color = "black") +
  scale_fill_manual(values = colores_partidos) + 
  theme_minimal() +
  labs(title = "Noviembre 2019",
       fill = "") +
  guides(alpha = "none") +
  theme(
    legend.position = "bottom",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))

grid.arrange(grafico_pais_08, grafico_pais_15 , grafico_pais_19, ncol = 3, nrow = 1)

Votos a candidatura en los municipios grandes

  • Se filtran los datos según el censo de los municipios

  • Se escogen los partidos más votados por municipio en cada elección

  • Se calcula en cuántos municipios gana cada partido

Code
# DATOS PREGUNTA 1
datos_p1 <- 
  tabla_maestra |> #Una fila por municipio
  filter(censo > 100000) |> #Condición del censo
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> #Partido más votado por elección
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  #Quito filas repetidas (partidos resultantes de la agrupación)
  group_by(anno, mes) |> 
  count(siglas) |> #Por elección cuento nº de veces qeu aparece el partido como más votado (=nº de municipios donde ganó) 
  ungroup() |> 
  mutate(
    siglas = factor(siglas, levels = unique(siglas)), # Aseguramos el orden
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

plot_p1 <- ggplot(datos_p1, aes(fill = siglas, values = n)) +
  geom_waffle(n_rows = 10) +
  facet_grid(~eleccion) +
  scale_fill_manual(values = colores_partidos) +
  labs(title = "Partidos ganadores en municipios con >100.000 habitantes",
         fill = "Partido") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    axis.text = element_blank(),
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank())

¿Qué partido fue el segundo cuando el primero fue el PSOE? ¿Y cuando el primero fue el PP?

En la mayoría de municipios grandes gana el PP o el PSOE, ¿son siempre los partidos más populares?

Code
# DATOS PREGUNTA 2

datos_p2_previo <-
  tabla_maestra |>
  filter(censo > 100000) |> 
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas)

# Apartado a: El PSOE es el primer partido

datos_p2_psoe_prim <-
  datos_p2_previo |> 
  filter(siglas == "PSOE")

datos_p2_a <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_psoe_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PSOE es el primero
plot_p2_a <- datos_p2_a |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PSOE",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")

datos_p2_pp_prim <-
  datos_p2_previo |> 
  filter(siglas == "PP")

datos_p2_b <- 
  tabla_maestra |> 
  filter(censo > 100000) |> 
  distinct(anno, mes, municipio, cod_poblacion, siglas, votos_totales_partido) |>
  group_by(anno, mes, cod_poblacion) |> 
  slice_max(votos_totales_partido, n = 2) |> 
  mutate(rank_grupo = rank(-votos_totales_partido)) |> 
  filter(rank_grupo == 2) |> 
  inner_join(datos_p2_pp_prim, by = c("cod_poblacion", "anno", "mes"), suffix = c("_seg", "_prim")) |> 
  group_by(anno, mes) |> 
  count(siglas_seg) |>
  ungroup() |> 
  mutate(
    siglas = factor(siglas_seg, levels = unique(siglas_seg)), 
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ 
      "2019 (abril)",
      anno == 2019 & mes == "11" ~ 
        "2019 (noviembre)"
    )
  )

# Gráfico para ver qué partidos son los segundos más votados cuando el PP es el primero
plot_p2_b <- datos_p2_b |> 
  mutate(eleccion = fct_reorder(eleccion, desc(eleccion))) |> 
  group_by(eleccion) |> 
  mutate(perc = scales::percent(n / sum(n), accuracy = .1, trim = FALSE)) |> 
  ungroup() |> 
  ggplot(aes(x = eleccion, y = n,fill = siglas_seg))  +
  geom_col(position = "fill") + 
  scale_fill_manual(values = colores_partidos) + 
  labs(title = "Segundo partido más votado tras el PP",
       subtitles = "En municipios con >100.000 habitantes",
         fill = "Partido",
       x = "Elecciones",
       y= "") +
  theme_minimal() +
  theme(
    legend.position = "bottom",
    strip.text = element_text(face = "bold",
                              size =9),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)),
    panel.grid = element_blank()) +
  coord_flip() +
  geom_text(aes(label = perc, y = n / 2),
    position = position_fill(vjust = 0.5),
    size = 3, color = "white")

Evolución del Porcentaje de Voto en Relación al Censo por Comunidad Autónoma

Code
tabla_pg4 <- 
  tabla_maestra |>
  # Votos totales por población
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

tabla_pg4_censo <-
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

tabla_pg4_censoxvotos <-
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(
    porc = votos_tot / censo_tot,
    comunidad_autonoma = case_when(
      codigo_ccaa == "01" ~ "Andalucía",
      codigo_ccaa == "02" ~ "Aragon",
      codigo_ccaa == "03" ~ "Asturias",
      codigo_ccaa == "04" ~ "Baleares",
      codigo_ccaa == "05" ~ "Canarias",
      codigo_ccaa == "06" ~ "Cantabria",
      codigo_ccaa == "07" ~ "Castilla y Leon",
      codigo_ccaa == "08" ~ "Castilla La Mancha",
      codigo_ccaa == "09" ~ "Cataluña",
      codigo_ccaa == "10" ~ "Comunidad Valenciana",
      codigo_ccaa == "11" ~ "Extremadura",
      codigo_ccaa == "12" ~ "Galicia",
      codigo_ccaa == "13" ~ "Comunidad de Madrid",
      codigo_ccaa == "14" ~ "Murcia",
      codigo_ccaa == "15" ~ "Navarra",
      codigo_ccaa == "16" ~ "País Vasco",
      codigo_ccaa == "17" ~ "La Rioja",
      codigo_ccaa == "18" ~ "Ceuta",
      TRUE ~ "Melilla"
    )
  )

# Graficar los datos
ggplot(tabla_pg4_censoxvotos) +
  geom_line(aes(x = anno, y = porc, color = comunidad_autonoma), size = 0.7, alpha = 0.8) +
  scale_x_continuous(
    breaks = seq(2007, 2020, by = 1), 
    labels = seq(2007, 2020, by = 1)
  ) +
  scale_color_viridis_d() + 
  labs(
    title = "Relación entre Votos Totales y Censo Total por Comunidad Autónoma",
    x = "Año",
    y = "Porcentaje de Votos sobre Censo",
    color = "Comunidad Autónoma"
  ) +
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9)
  )
Code
#Se observa como el porcentaje de votos respecto al censo fue disminuyendo alrededor del 2015 para la mayoría de comunidades, seguido de una recuperacíon en los años posteriores (hacia 2017-2018).

#Las comunidades tienen diferentes niveles de participación. Algunas mantienen un porcentaje más alto (cerca del 80%), mientras que otras caen a valores significativamente más bajos (alrededor del 50% en algunos años).

Evolución del Porcentaje de Voto en Relación al Censo por Comunidad Autónoma

Code
# Crear tabla con votos totales por población
tabla_pg4 <- 
  tabla_maestra |>
  group_by(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion) |>
  summarise(votos_totales = sum(votos)) |>
  distinct(anno, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, votos_totales)

# Crear tabla con el censo
tabla_pg4_censo <- 
  tabla_maestra |> 
  distinct(anno, mes, codigo_ccaa, codigo_provincia, codigo_municipio, cod_poblacion, censo)

# Unir las dos tablas y calcular porcentaje de votos sobre censo
tabla_pg4_censoxvotos <- 
  left_join(x = tabla_pg4_censo, 
            y = tabla_pg4, 
            by = c("anno" = "anno", 
                   "mes" = "mes",
                   "codigo_ccaa" = "codigo_ccaa",
                   "codigo_provincia" = "codigo_provincia",
                   "codigo_municipio" = "codigo_municipio",
                   "cod_poblacion" = "cod_poblacion")) |> 
  group_by(anno, mes, codigo_ccaa) |> 
  summarise(censo_tot = sum(censo), votos_tot = sum(votos_totales)) |> 
  mutate(porc = votos_tot / censo_tot,
         comunidad_autonoma = case_when(
           codigo_ccaa == "01" ~ "Andalucia",
           codigo_ccaa == "02" ~ "Aragon",
           codigo_ccaa == "03" ~ "Asturias",
           codigo_ccaa == "04" ~ "Baleares",
           codigo_ccaa == "05" ~ "Canarias",
           codigo_ccaa == "06" ~ "Cantabria",
           codigo_ccaa == "07" ~ "Cast y Leon",
           codigo_ccaa == "08" ~ "Cast La Mancha",
           codigo_ccaa == "09" ~ "Catalunya",
           codigo_ccaa == "10" ~ "Com Valenciana",
           codigo_ccaa == "11" ~ "Extremadura",
           codigo_ccaa == "12" ~ "Galicia",
           codigo_ccaa == "13" ~ "Com de Madrid",
           codigo_ccaa == "14" ~ "Murcia",
           codigo_ccaa == "15" ~ "Navarra",
           codigo_ccaa == "16" ~ "Pais Vasco",
           codigo_ccaa == "17" ~ "La Rioja",
           codigo_ccaa == "18" ~ "Ceuta",
           TRUE ~ "Melilla"
         ),
      fecha = as.Date(paste(anno, mes, "01", sep = "-"))) |> 
  group_by(codigo_ccaa) |> 
  mutate(mean_porc = mean(porc),
         tipos_ccaa = case_when(
           mean_porc > 0.74 ~ "Porc > 0.73",
           mean_porc > 0.71 ~ "Porc > 0.71 y < 0.73",
           mean_porc > 0.65 ~ "Porc > 0.65 y < 0.71",
           TRUE ~ "Porc <= 0.65"
         ))

# Graficar los datos

grafica_menos65 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc <= 0.65")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje <= 0.65"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje entre 0.65 y 0.71
grafica_menos71 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.65 y < 0.71")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje entre 0.65 y 0.71"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje entre 0.71 y 0.73
grafica_menos73 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.71 y < 0.73")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +   
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje entre 0.71 y 0.73"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

# Gráfica para el porcentaje > 0.73
grafica_mas73 <- 
  ggplot(tabla_pg4_censoxvotos |>  
           filter(tipos_ccaa == "Porc > 0.73")) +
  geom_line(aes(x = fecha, y = porc, color = comunidad_autonoma), size = 1, alpha = 0.8) +  
  scale_x_date(
    breaks = as.Date(c("2008-01-01", "2011-01-01", "2015-01-01", "2016-01-01", "2018-01-01", "2019-01-01")),
    labels = c("2008", "2011", "2015", "2016", "2018", "2019")  
  ) +
  scale_y_continuous(
    labels = function(porc) paste0(porc * 100, "%")        
  ) +
  scale_color_viridis_d() +  
  labs(
    color = "Porcentaje de voto",
    subtitle = "Porcentaje > 0.73"
  ) +  
  theme_minimal() +
  theme(
    legend.title = element_text(size = 10),
    legend.text = element_text(size = 9),
    axis.title.y = element_blank(),
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 80, size = 7),
    strip.text = element_text(face = "bold", size = 4.5),
    plot.title = element_text(face = "bold", hjust = 0.5, margin = margin(b = 10)),
    panel.grid = element_blank()
  )

grid.arrange(grafica_menos65, grafica_menos71, grafica_menos73, grafica_mas73, ncol = 2, nrow = 2, top = "Porcentaje de voto por comunidad")
Code
#Se observan disparidades en la participación electoral por comunidad autónoma, con Ceuta y Melilla (\<60 %) en el nivel más bajo y comunidades como La Rioja y País Vasco (\> 70%) en el más alto.

#Las regiones con menor participación muestran cierta recuperación hacia 2018, mientras que las comunidades con alta participación mantienen estabilidad a lo largo del tiempo.

¿Es cierto que determinados partidos ganan en las zonas rurales?

Code
tabla_maestra <- tabla_maestra |> 
  mutate(zona = case_when(
    censo < 10000 ~ "rural",  
    TRUE ~ "urbano"
  ))
# Análisis de partidos ganadores en zonas rurales
datos_rurales <- 
  tabla_maestra |>  
  filter(zona == "rural") |>  
  slice_max(votos_totales_partido, by = c(anno, mes, cod_poblacion)) |>  
  distinct(anno, mes, municipio, cod_poblacion, siglas) |>  
  group_by(anno, mes) |>  
  count(siglas) |>  
  ungroup() |>  
  mutate(
    siglas = factor(siglas, levels = unique(siglas)),  
    eleccion = case_when(
      anno == 2008 ~ "2008",
      anno == 2011 ~ "2011",
      anno == 2015 ~ "2015",
      anno == 2016 ~ "2016",
      anno == 2019 & mes == "04" ~ "2019 (abril)",
      anno == 2019 & mes == "11" ~ "2019 (noviembre)"
    )
  )

datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f","VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")
Code
## Se observa como el PP es el partido dominante en las zonas rurales
Code
# Crear la tabla con el número de municipios ganados por cada partido
tabla_partidos_rurales <- datos_rurales |> 
  group_by(siglas) |> 
  summarise(municipios_ganados = sum(n)) |> 
  arrange(desc(municipios_ganados)) |> 
  mutate(mensaje = glue("{siglas} ganó en {municipios_ganados} municipios rurales"))
tabla_partidos_rurales
# A tibble: 10 × 3
   siglas     municipios_ganados mensaje                                  
   <fct>                   <int> <glue>                                   
 1 PP                      24019 PP ganó en 24019 municipios rurales      
 2 PSOE                    13129 PSOE ganó en 13129 municipios rurales    
 3 OTRO                     5124 OTRO ganó en 5124 municipios rurales     
 4 ERC                      1091 ERC ganó en 1091 municipios rurales      
 5 PNV                       717 PNV ganó en 717 municipios rurales       
 6 PODEMOS-IU                682 PODEMOS-IU ganó en 682 municipios rurales
 7 EH-BILDU                  464 EH-BILDU ganó en 464 municipios rurales  
 8 VOX                       345 VOX ganó en 345 municipios rurales       
 9 C's                       158 C's ganó en 158 municipios rurales       
10 BNG                         6 BNG ganó en 6 municipios rurales         
tabla_partidos_rurales
# A tibble: 10 × 3
   siglas     municipios_ganados mensaje                                  
   <fct>                   <int> <glue>                                   
 1 PP                      24019 PP ganó en 24019 municipios rurales      
 2 PSOE                    13129 PSOE ganó en 13129 municipios rurales    
 3 OTRO                     5124 OTRO ganó en 5124 municipios rurales     
 4 ERC                      1091 ERC ganó en 1091 municipios rurales      
 5 PNV                       717 PNV ganó en 717 municipios rurales       
 6 PODEMOS-IU                682 PODEMOS-IU ganó en 682 municipios rurales
 7 EH-BILDU                  464 EH-BILDU ganó en 464 municipios rurales  
 8 VOX                       345 VOX ganó en 345 municipios rurales       
 9 C's                       158 C's ganó en 158 municipios rurales       
10 BNG                         6 BNG ganó en 6 municipios rurales         
Code
# Partidos ganadores en zonas rurales por año
datos_rurales |> 
  ggplot(aes(x = reorder(siglas, -n), y = n, fill = siglas)) +  
  geom_bar(stat = "identity") +  
  scale_fill_manual(values = c("OTRO" = "grey45", "PP" = "#17589d", "PNV" = "#308444", 
                               "PODEMOS-IU" = "#6b1f5f", "VOX" = "#5ac035", 
                               "PSOE" = "#c20e1a", "ERC" = "#fcc34e", "BNG" = "#76b3dd",
                               "C's" = "#fb5000")) +  
  labs(
    title = "Partidos Ganadores en Zonas Rurales por Año",
    x = "Partido",
    y = "Número de Municipios Rurales Ganados",
    fill = "Partido"
  ) +
  facet_wrap(~ eleccion) +  
  theme_minimal() +  
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +  
  theme(legend.position = "none")

Resultados de las encuestas

¿Cómo calibrar el error de las encuestas?

Podemos ver que los resultados de las encuestas se suelen desviar entre cero con algo y 2 puntos porcentuales

Code
# Preparamos los datos de las encuestas, vemos qué porcentaje de votantes se estiman para cada partido

surveys_general <-
  surveys_tidy |> 
  distinct(date_elec, pollster, field_date_from, field_date_to, size, turnout) |> 
  mutate(personas_turnout = round((size * turnout)/100),0) |> 
  group_by(date_elec, pollster) |> 
  mutate(size = sum(size),
         personas_turnout = sum(personas_turnout, na.rm = TRUE),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)")) |> 
  distinct(eleccion, pollster, size, personas_turnout)
  
surveys_partido <-
  surveys_tidy |> 
  mutate(votantes = round(((size - turnout)*intencion_voto)/100, 0)) |> 
  group_by(date_elec, pollster, siglas) |> 
  mutate(votantes_estimados = sum(votantes, na.rm = TRUE)) |> 
  distinct(date_elec, pollster, siglas, votantes_estimados) |> 
  left_join(surveys_general, by = c("date_elec" = "date_elec", "pollster" = "pollster")) |> 
  mutate(votos_porc_votantes_cand = round(votantes_estimados / (size - personas_turnout), 2),
         votos_porc_censo = round(votantes_estimados / size, 2),
         eleccion =  case_when(
            year(date_elec) == 2008 ~ "2008",
            year(date_elec)  == 2011 ~ "2011",
            year(date_elec)  == 2015 ~ "2015",
            year(date_elec)  == 2016 ~ "2016",
            year(date_elec)  == 2019 & month(date_elec)  == "4" ~ 
            "2019 (abril)",
            year(date_elec)  == 2019 &  month(date_elec) == "11" ~ 
              "2019 (noviembre)"))  |> 
  group_by(eleccion, siglas) |> 
  mutate(media_porc_encuesta = mean(votos_porc_votantes_cand)) |> 
  ungroup()

# Comparamos los datos reales vs los de las encuestas

comparacion <- 
  left_join(x = surveys_partido, y = datos_partido, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |> 
  select (eleccion, pollster, siglas, votos_porc_votantes_cand.x, votos_porc_votantes_cand.y, votos_porc_censo.x, votos_porc_censo.y) |> 
  mutate(error_relativo_cand = abs(votos_porc_votantes_cand.y - votos_porc_votantes_cand.x) / votos_porc_votantes_cand.y,
         error_relativo_censo = abs(votos_porc_censo.y - votos_porc_censo.x) / votos_porc_censo.y,
         error_real = (votos_porc_votantes_cand.x - votos_porc_votantes_cand.y) / votos_porc_votantes_cand.y ,
         error_positivo_negativo = case_when (error_real >=0 ~ "Positivo", TRUE ~ "Negativo")) |> 
  drop_na(eleccion)
Code
# Propuesta 0 : caja y bigotes

grafico_comparacion_partido <-
  ggplot(comparacion, aes(x = error_relativo_cand, y = siglas, fill = siglas)) +
  geom_boxplot() +
  facet_wrap(~eleccion) +
  scale_fill_manual(values = colores_partidos)  +
    labs(
    x = "Error absoluto relativo",
    y = "Partido",
    fill = "Partido"
  ) +
  guides(fill = "none")
grafico_comparacion_partido
Code
# Propuesta 3: lollipop por años con el promedio
datos_partido_ganador <- 
  datos_partido |> 
  group_by(eleccion) |> 
  slice_max(votos_partido)

comparacion_filtro3 <- 
  comparacion |> 
  inner_join(y = datos_partido_ganador, by = c("eleccion" = "eleccion", "siglas" = "siglas")) |>
  group_by(eleccion) |> 
  mutate(promedio_error = mean(error_real)) |> 
  distinct(eleccion, promedio_error)


ggplot(comparacion_filtro3, aes(x = eleccion, y = promedio_error)) +
  geom_segment( aes(x = eleccion, xend = eleccion, y=0, yend = promedio_error), color="grey", size = 1.2) +
  geom_point( color="orange", size = 4) +
  theme_light() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.border = element_blank(),
    axis.ticks.x = element_blank(),
    axis.text.x = element_text(angle = 90)
  ) +
  xlab("") +
  ylab("Desviación de los votos reales (porcentual)") +
  coord_flip()

Precisión de la participación estimada

¿La intención de voto reportada en las encuestas muestra tendencias consistentes con las tasas de participación reales en todas las elecciones?

Code
participacion_actual <- tabla_maestra |> 
  group_by(anno, mes) |> 
  summarise(
    censo_total = sum(censo, na.rm = TRUE),
    votos_candidaturas_total = sum(votos_candidaturas, na.rm = TRUE),
    .groups = "keep"
  ) |>
  mutate(participacion_rate_actual = votos_candidaturas_total / censo_total)


participacion_actual <- participacion_actual |> 
  mutate(
    year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d")
  )


ggplot(participacion_actual, aes(x = year_month, y = participacion_rate_actual)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Porcentaje de participación real por año y mes",
    x = "Año-Mes",
    y = "Porcentaje de participación (Actual)"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_actual$year_month  
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1), 
    legend.position = "none",
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10)))
Code
survey_participacion_month <- surveys_tidy |> 
  mutate(
    anno = year(as.Date(date_elec)),  
    mes = month(as.Date(date_elec))  
  ) |> 
  group_by(anno, mes) |> 
  summarise(
    turnout_mean = mean(turnout, na.rm = TRUE)/100, 
    .groups = "drop"
  ) |> 
  mutate(year_month = as.Date(paste(anno, mes, "1", sep = "-"), format = "%Y-%m-%d"))

ggplot(survey_participacion_month, aes(x = year_month, y = turnout_mean)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  labs(
    title = "Participación electoral promedio por año y mes",
    x = "Año-Mes",
    y = "Participación media"
  ) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = survey_participacion_month$year_month) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1) ,
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10))
  )
Code
participacion_diff <- left_join(
  participacion_actual, survey_participacion_month, by = "year_month"
) |> 
  mutate(
    participacion_diff = participacion_rate_actual - (turnout_mean / 100)
  )

ggplot(participacion_diff, aes(x = year_month, y = participacion_diff)) +
  geom_line(color = "blue", size = 1) +
  geom_point(color = "red", size = 2) +
  scale_x_date(
    date_labels = "%Y-%m",
    breaks = participacion_diff$year_month) +
  labs(
    title = "Diferencia entre las tasas de participación reales y previstas",
    x = "Año-Mes",
    y = "Diferencia en el porcentaje de participación (real - prevista)"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(face = "bold",
                              hjust = 0.5,
                              margin = margin(b = 10))
  )

Resultados en el Congreso de los Diputados

El Congreso de los Diputados en España se encarga de debatir y redactar las leyes que se implementan en el país

  • 350 diputados

  • 52 circunscripciones electorales: 50 provincias + 2 ciudades autónomas (Ceuta y Melilla)

Reparto de escaños por circunscripción:

  • Ceuta y Melilla \(\rightarrow\) 1 escaño cada una

  • El resto de circunscripciones electorales \(\rightarrow\) como mínimo 2 escaños

Con esto tenemos ya repartidos 102 escaños.

¿Cómo repartimos los 248 restantes?

Se utiliza un reparto proporcional a la población, de forma que tenemos la siguiente distribución de escaños por provincias:

Y si entramos al detalle, provincia a provincia:

Ahora bien, ¿cómo se asignan estos escaños a los partidos en cada circunscripción?

SISTEMA D’HONDT

Este sistema es un método de asignación de escaños en sistemas de representación proporcional

Sistema D´Hondt: ¿Cómo funciona?

  • Se realiza el algoritmo para cada circunscripción

  • Los partidos deben de tener como mínimo el 3% de votos válidos de la circunscripción

  • Asignación mediante el cálculo de cocientes sucesivos

\[cociente_{ij} = \frac{\text{votos del partido}_{i}}{escaño_{j}}\]

Donde el índice \(i\) varía desde 1 hasta el número total de partidos en la circunscripción (que cumplen la norma anterior)

Y el índice \(j\) varía desde 1 hasta el número de escaños a asignar en la provincia

Veamos un ejemplo sencillo

Supongamos que nos encontramos en una circunscripción a la que tenemos que asignar 3 escaños, y tenemos 3 partidos con los siguientes votos:

Tenemos que dividir los votos de los partidos entre todos los números entre 1 y el número de escaños, que son 1, 2 y 3.

Una vez tenemos estos cocientes, se seleccionan tantas casillas como escaños podemos asignar, de forma que las casillas seleccionadas son las que tienen cocientes más altos (señaladas en naranja).

Hemos creado una función para poder replicar este algoritmo con los datos de nuestras elecciones y los datos de los escaños que hemos importado previamente.

## Función D'Hondt
dHondt <- function(votos, partidos, escaños) {
  # Formato tibble
  tabla <- tibble(partido = partidos, votos = votos)
  # Divisores
  divisores <- rep(1, length(votos))
  escaños_asignados <- integer(length(votos))
  # Tenemos que repetir el proceso por escaños
  for (i in 1:escaños) {
    # Máximo cociente
    cocientes <- votos / divisores
    max_index <- which.max(cocientes)
    escaños_asignados[max_index] <- escaños_asignados[max_index] + 1
    divisores[max_index] <- divisores[max_index] + 1}
  # Resultado final
  resultado <- tibble(
    partido = partidos,
    escaños = escaños_asignados)
  return(resultado)
}

## Función D'Hondt 2: ahora es personal 
# (por provincias y elecciones)

dHondt_provincias <- function(tibble) {
  # Inicializamos los resultados
  resultados_dhondt <- tibble()
  # Por cada elección de las que tenemos
  for (elec in unique(tibble$eleccion)) {
    # Filtrar por elección actual
    tibble_funcion <- 
      tibble |> 
      filter(eleccion == elec)
    # Por cada provincia, ya que cada una tiene unos escaños
    for (provin in unique(tibble_funcion$codigo_provincia)) {
      # Filtrar por provincia actual
      tibble_funcion2 <- 
        tibble_funcion |> 
        filter(codigo_provincia == provin)
      # Aplicamos la función de antes
      resultados <- 
        dHondt(
        votos = tibble_funcion2$votos_partido, 
        partidos = tibble_funcion2$partido, 
        escaños = unique(tibble_funcion2$`Número de escaños`))
      # Añadimos qué elección es y provincia
      resultados <- 
        resultados |> 
        mutate(eleccion = elec, 
               codigo_provincia = provin)
      # Añadimos a la inicialización
      resultados_dhondt <- bind_rows(resultados_dhondt, resultados)}}
  return(resultados_dhondt)}

resultado_dhondt <-
  dHondt_provincias(datos_provincia_escannos) 

Aplicamos esta función para obtener los resultados del congreso de cada elección general

Code
## Gráfico de congreso

# Tenemos que filtar por años, porque la geometria geom_parliament() da problemas
# con las leyends de colores/relleno con los facet wrap si los niveles de las 
# leyendas no son exactamente los mismos siempre.

# 2008 #

congreso_2008 <-
congreso |> 
           filter(eleccion == "2008")

# congreso_2008 |> 
#   group_by(siglas) |> 
#   summarise(escannos) |> 
#   arrange(escannos)

colores_2008 <- c(
  "8" = "#17589d", # PP
  "9" = "#c20e1a", # SOE
  "6" = "#308444", # PNV 
  "5" = "#808080", # OTRO 
  "7" = "#308444", # PNV
  "10" = "#308444", # PNV
  "4" = "#FFD700", #ERC
  "3" = "#76b3dd",
  "1" = "#76b3dd"
  )

congreso_2008_g <- 
  ggplot(congreso_2008)+
  geom_parliament(
    aes(
      seats = escannos, 
      fill = siglas,
      color = siglas)) +
  scale_fill_manual(values = colores_2008) +
  scale_color_manual(values = colores_2008) +
  guides(color = "none", fill = "none") +
  theme(axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        panel.background = element_rect(fill = "white", color = NA)) +
  coord_fixed()
  

congreso_2008_t <-
  congreso_2008 |> 
  filter(eleccion == "2008" ) |> 
  select(siglas, escannos) |> 
  arrange(- escannos) |> 
  filter(escannos > 0)

congreso_2008_tg <- 
  ggplot(congreso_2008_t, aes(x = 1, y = reorder(siglas, escannos), label = paste(siglas, escannos))) +
  geom_text(aes(color = siglas), size = 3.5) + # Añadir texto con colores
  scale_color_manual(values = colores_partidos) + # Usa los colores definidos en la tabla
  theme_minimal() +
  guides(color = "none") +
  theme(
    axis.text = element_blank(),
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

grafico_congreso1 <- grid.arrange(congreso_2008_g, congreso_2008_tg, ncol = 2,
             top = textGrob("2008", gp = gpar(fontsize = 12, fontface = "bold") 
  ))

Bonus track: Mayoría absoluta

La mayoría absoluta en el Congreso corresponde a la mitad de los escaños más uno, es decir: 176.

Esta mayoría absoluta facilita la formación del gobierno, ya que no hace falta negociar con más partidos para poder proponer un candidato a la investidura del Gobierno.

En la diapositiva anterior podemos ver que, de las 6 elecciones que estamos analizando, esta mayoría sólo se ha alcanzado en 2011.

Conclusiones

  • Participación Electoral: En torno a 2015, la participación disminuyó, pero se recuperó hacia 2017-2018.

  • Diferencias Regionales: Algunas comunidades se mantienen cerca del 80%, mientras que otras caen al 50% en ciertos años.

  • Cambio Político: Desde 2008, el bipartidismo ha dado paso a nuevos partidos como Podemos y Vox, complicando las mayorías absolutas y forzando coaliciones.

  • Municipios Grandes: Los partidos tradicionales siguen liderando, pero desde 2015, los nuevos partidos han ganado apoyo.